home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbuf2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-12-28  |  4.9 KB  |  164 lines

  1. (*===========================================================================*)
  2. (* Add/init users                                                            *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991 by H. Roy Engehausen.  All rights      *)
  5. (*   reserved.                                                               *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. (*===========================================================================*)
  10. (* Add uid to user list                                                      *)
  11. (*===========================================================================*)
  12.  
  13. PROCEDURE add_uid (uid_to_add : user_record_ptr);
  14.  
  15.   VAR
  16.     uid_index_current : user_index_ptr;
  17.  
  18.   BEGIN;
  19.  
  20.     {$IFDEF POINT_CHK}
  21.       test_pointer(uid_to_add);
  22.     {$ENDIF}
  23.  
  24.     (*-----------------------------------------------------------------------*)
  25.     (* Obtain the interrupt lock                                             *)
  26.     (*-----------------------------------------------------------------------*)
  27.  
  28.     get_semaphore(semaphore_interrupts, sem_exclusive, FALSE);
  29.  
  30.     IF uid_free <> NIL THEN
  31.       BEGIN;
  32.  
  33.         {$IFDEF POINT_CHK}
  34.           test_pointer(uid_free);
  35.         {$ENDIF}
  36.  
  37.         uid_index_current := uid_free;
  38.         uid_free := uid_index_current^.user_next;
  39.  
  40.       END
  41.     ELSE
  42.       BEGIN;
  43.  
  44.         NEW(uid_index_current);
  45.         uid_total := uid_total + 1;
  46.         uid_index_current^.user_recno := uid_total;
  47.  
  48.       END;
  49.  
  50.     uid_to_add^.user_i_ptr := uid_index_current;
  51.  
  52.     WITH uid_index_current^ DO
  53.       BEGIN
  54.  
  55.         user_id := uid_to_add^.user_id;
  56.  
  57.         IF (uid_to_add^.user_flag AND user_f_delete) <> 0 THEN
  58.           BEGIN;
  59.             user_next := uid_free;
  60.             uid_free  := uid_index_current;
  61.           END
  62.         ELSE
  63.           insert_uid(uid_index_current);
  64.  
  65.         IF user_recno > uid_total THEN
  66.           BEGIN;
  67.             WRITELN('Add failure!');
  68.             WRITELN('ARecord =', user_recno);
  69.             WRITELN('Utotal  =', uid_total);
  70.             WRITELN('tcb     =', active_tcb^.port_chan_s);
  71.             user_recno := uid_total;
  72.             EXIT;
  73.           END;
  74.  
  75.         SEEK(uid_file, user_recno);
  76.  
  77.         WRITE(uid_file, uid_to_add^);
  78.  
  79.       END;
  80.  
  81.     (*-----------------------------------------------------------------------*)
  82.     (* Release the interrupt lock                                            *)
  83.     (*-----------------------------------------------------------------------*)
  84.  
  85.     free_semaphore(semaphore_interrupts);
  86.  
  87.   END;
  88.  
  89. (*===========================================================================*)
  90. (* Initialize a user's record                                                *)
  91. (*===========================================================================*)
  92.  
  93. PROCEDURE uid_init(uid_data : user_record_ptr);
  94.   BEGIN;
  95.  
  96.     {$IFDEF POINT_CHK}
  97.       test_pointer(uid_data);
  98.     {$ENDIF}
  99.  
  100.     FILLCHAR(uid_data^, SIZEOF(user_record_type), CHR(0));
  101.  
  102.     uid_data^.user_name    := '?';
  103.     uid_data^.user_port    := active_port^.port_char;
  104.     uid_data^.user_class   := user_c_nu;
  105.     uid_data^.user_scr_len := active_port^.dflt_scrl;
  106.     uid_data^.user_lang    := '?';
  107.     uid_data^.user_fmt     := active_port^.new_display;
  108.     uid_data^.user_l_time  := last_midnight
  109.                                          - LONGINT(opt_block.newuser_l_time)
  110.                                                                * ticks_per_day;
  111.  
  112.     IF active_port^.port_dflt_trans THEN
  113.       uid_data^.user_flag  := user_f_trans;
  114.  
  115.   END;
  116.  
  117. (*===========================================================================*)
  118. (* Insert a user's record into the chain                                     *)
  119. (*===========================================================================*)
  120.  
  121. PROCEDURE insert_uid(uid_to_ins : user_index_ptr);
  122.  
  123.   VAR
  124.  
  125.     uid_last : user_index_ptr;
  126.     uid_work : user_index_ptr;
  127.  
  128.   BEGIN;
  129.  
  130.     {$IFDEF POINT_CHK}
  131.       test_pointer(uid_to_ins);
  132.     {$ENDIF}
  133.  
  134.     uid_last := NIL;
  135.     uid_work := uid_chain;
  136.  
  137.     WHILE (uid_work <> NIL) AND (uid_work^.user_id < uid_to_ins^.user_id) DO
  138.       BEGIN;
  139.  
  140.         {$IFDEF POINT_CHK}
  141.           test_pointer(uid_work);
  142.         {$ENDIF}
  143.  
  144.         uid_last := uid_work;
  145.         uid_work := uid_work^.user_next;
  146.  
  147.       END;
  148.  
  149.     IF (uid_work <> NIL) AND (uid_work^.user_id = uid_to_ins^.user_id) THEN
  150.       WRITELN('Duplicate userids -- ', uid_work^.user_id);
  151.  
  152.     IF uid_last = NIL THEN
  153.       BEGIN;
  154.         uid_to_ins^.user_next := uid_chain;
  155.         uid_chain             := uid_to_ins;
  156.       END
  157.     ELSE
  158.       BEGIN;
  159.         uid_to_ins^.user_next := uid_last^.user_next;
  160.         uid_last^.user_next   := uid_to_ins;
  161.       END;
  162.  
  163.   END;
  164.